home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PASCALL
/
CLOCKIN
/
CLOCK1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-25
|
5KB
|
171 lines
program graphclock;
uses
graph,graphin1,dos,crt;
label
1;
var
beeper,stop:boolean;
const
lasthour:word=hrhandsize;
lastminute:word=minhandsize;
lastsecond:word=sechandsize;
lasthundrethofasecond:word=hndthsechandsize;
var
hour,minute,second,hundrethofasecond:word;
txh,txw,txs,tys:integer;
function printmonth(month:word):string;
begin
case month of
1: printmonth:='january';
2: printmonth:='february';
3: printmonth:='march';
4: printmonth:='april';
5: printmonth:='may';
6: printmonth:='june';
7: printmonth:='july';
8: printmonth:='august';
9: printmonth:='september';
10: printmonth:='october';
11: printmonth:='november';
12: printmonth:='december'
else exit;
end;
end;
function printdayofweek(day:word):string;
begin
case day of
0: printdayofweek:='sunday';
1: printdayofweek:='monday';
2: printdayofweek:='tuesday';
3: printdayofweek:='wednesday';
4: printdayofweek:='thursday';
5: printdayofweek:='friday';
6: printdayofweek:='saturday'
else exit;
end;
end;
procedure preset;
begin
txh:=textheight('d');
txw:=textwidth('d');
setcolor(white);
txs:=textwidth(' : : . ');
txs:=centerx-(txs-txw div 2) div 2;
tys:=centery-txh div 2;
outtextxy(txs+1,tys+1,' : : . ');
end;
procedure putoutclocktimer;
{var
txx:integer;}
begin
gettime(hour,minute,second,hundrethofasecond);
setcolor(white);
{ txx:=centerx-(txs-txw div 2) div 2;
bar(txx,tys,txx+11*txs,tys+txh);
outtextxy(txx+1,tys+1,concat(streng(hour),':',streng(minute),':',streng(second),'.',streng(hundrethofasecond)));}
if not(lasthour=hour) then begin
puthand(lasthour,hour,hr);
lasthour:=hour;
setcolor(white);
bar(txs,tys,txs+2*txw,tys+txh);
if hour=0 then hour:=hrhandnumber;
outtextxy(txs+1,tys+1,streng(hour));
end;
if not(lastminute=minute) then begin
puthand(lastminute,minute,min);
lastminute:=minute;
setcolor(white);
bar(txs+3*txw,tys,txs+5*txw,tys+txh);
if minute=0 then minute:=minhandnumber;
outtextxy(txs+3*txw,tys+1,streng(minute));
end;
if not(lastsecond=second) then begin
puthand(lastsecond,second,sec);
setcolor(white);
bar(txs+6*txw,tys,txs+8*txw,tys+txh);
if (beeper) and not(lastsecond=second) then beep;
lastsecond:=second;{
if second=0 then second:=sechandnumber;
outtextxy(txs+6*txw,tys+1,streng(second));
end;
if not(lasthundrethofasecond=hundrethofasecond) then begin
puthand(lasthundrethofasecond,hundrethofasecond,hndthsec);
lasthundrethofasecond:=hundrethofasecond;
setcolor(white);
bar(txs+9*txw,tys,txs+12*txw,tys+txh);
if hundrethofasecond=0 then hundrethofasecond:=hndthsechandnumber;
outtextxy(txs+9*txw,tys+1,streng(hundrethofasecond));
end;
end;
function inkey:char;
begin
if keypressed then inkey:=readkey else inkey:=chr(1);
end;
{procedure putoutclock;
const
lasthour:word=hrhandsize;
lastminute:word=minhandsize;
lastsecond:word=sechandsize;
lasthundrethofasecond:word=hndthsechandsize;
var
hour,minute,second,hundrethofasecond:word;
begin
repeat
gettime(hour,minute,second,hundrethofasecond);
if not(lasthour=hour) then begin
puthand(lasthour,hour,hr);
lasthour:=hour;
end;
if not(lastminute=minute) then begin
puthand(lastminute,minute,min);
lastminute:=minute;
end;
if not(lastsecond=second) then begin
puthand(lastsecond,second,sec);
if beeper then beep;
lastsecond:=second;
end;
if not(lasthundrethofasecond=hundrethofasecond) then begin
puthand(lasthundrethofasecond,hundrethofasecond,hndthsec);
lasthundrethofasecond:=hundrethofasecond;
end;
until keypressed;
end;}
procedure done;
begin
restorecrtmode;
closegraph;
halt;
end;
procedure doit;
begin
putoutclocktimer;
case ord(upcase(inkey)) of
27:done;
ord('S'):beeper:=not(beeper);
end;
centerc:=centerx;
end;
begin
beeper:=true;
setupgraph;
setupgrid;
preset;
centerx:=319
1:
{ for centerx:=241 to 399 do doit;
for centerx:=399 downto 241 do doit;}
doit;
goto 1;
end.